; Tandata TM512 DTI                                 Version 1.04 04-Jun-1991
; (c) 1990/1991 Hugo Fiennes

modem_initialise ()
  {
  port_rxclear()
  port_txspeed(1200)
  port_rxspeed(1200)
  $port_wordformat("7E1")

  type cr+cr
  if (waitfor("&+++",100))
    {
    return(0)
    }
  return(1)
  }

modem_shutdown ()
  {
  return(1)
  }

modem_connect ()
  {
  string reply[20],oldparity[3]

  port_dtr(1)
  port_rts(1)

  oldparity=$port_wordformat("7E1")
  
  if (port_rxspeed()==1200)
    {
    ; V23 originate mode
    port_txspeed(1200)
    port_rxspeed(1200)
    type "V23T"+cr
    pause(25)
    type "T"+cr
    }

  if (port_rxspeed()==300)
    {
    ; V21 originate mode
    port_txspeed(1200)
    port_rxspeed(1200)
    type "V21T"+cr
    pause(25)
    type "T"+cr
    }

  ; Wait for the &WAT string
  reply=$modeminput(30,modem_replywait)
  while(compare($left(reply,4),"&WAT")==0)
    {
    reply=$modeminput(30,modem_replywait)
    }

  return(_processmessage(oldparity))
  }

modem_disconnect ()
  {
  port_rts(0)
  port_dtr(0)
  pause 50
  port_dtr(1)
  port_rts(1)
  type $chr(1)+$chr(1)+$chr(1)+$chr(1)
  }

modem_dial (string number[40],integer how)
  {
  string newnumber[40]="",reply[45],oldparity[3]
  integer a

  port_dtr(1)
  port_rts(1)

  oldparity=$port_wordformat("7E1")

  if (port_rxspeed()==1200)
    {
    ; V23 originate mode
    port_txspeed(1200)
    port_rxspeed(1200)
    type "V23T"+cr
    pause(25)
    }

  if (port_rxspeed()==300)
    {
    ; V21 originate mode
    port_txspeed(1200)
    port_rxspeed(1200)
    type "V21T"+cr
    pause(25)
    }

  for a=1 to len(number)
    {
    if (instr("-,;",$mid(number,a)))
      {
      newnumber=newnumber+";"
      }
    if (isdigit($mid(number,a)))
      {
      newnumber=newnumber+$mid(number,a)
      }
    }

  type newnumber+cr

  ; Wait for the &WAT or &NDT string
  reply=$getmessage()
  while(compare(reply,"&WAT")==0)
    {
    if (compare(reply,"&NDT"))
      {
      return(3)
      }
    reply=$getmessage()
    }

  return(_processmessage(oldparity))
  }

modem_answer ()
  {
  port_txspeed(1200)
  port_rxspeed(1200)

  port_dtr(1)
  port_rts(1)

  ; Use 8N1 to ensure binary transfers
  $port_wordformat("8N1")

  type "AA"+cr

  do
    {
    pause(10)
    }
  while(port_dcd()==0)

  return(1)
  }

modem_ring ()
  {
  if (port_rxbuffer()<4)
    {
    return(0)
    }
  if (compare($getmessage(),"&RNG"))
    {
    return(1)
    }
  return(0)
  }

modem_errorcontrol (string option[10])
  {
  set(linklevel,none)

  if (comparei(option,"vasscom"))
    {
    set(linklevel,vasscom)
    }

  if (comparei($left(option,3),"mnp"))
    {
    set(linklevel,mnp)
    }
  }

modem_standard (string option[10])
  {
  if (comparei(option,"v21") || number==300)
    {
    type "V21T"+cr
    return
    }
  if (comparei(option,"v23") || number==1275)
    {
    type "V23T"+cr
    return
    }
  prints "Modem standard "+option+" is not supported."+newline
  }

_processmessage (string oldpar[3])
  {
  string retcode[5]

  ; Wait for message
  retcode=$getmessage()

  $port_wordformat(oldpar)

  switch(retcode)
    {
    case$("&CTL")
      {
      return(0)
      }
    }

  modem_disconnect()
  return(1)
  }

$getmessage ()
  {
  string retcode[4]=""
  integer a,t

  ; Wait for LF to indicate sequence starting
  waitfor($chr(10))
      
  t=time()
  for a=1 to 4
    {
    while(port_rxbuffer()==0)
      {
      pause(2)
      if ((time()-t)>500)
        {
        $return("&+++")
        }
      }
    retcode=retcode+$chr(port_rx())
    prints cr+retcode
    }

  $return(retcode)
  }
